Delphi Magazine Collection 2001/Delphi Magazine Collection 20001 (2001).iso/DISKS/ISSUE05/PERFORM/UNITPERF.PAS

Pascal/Delphi Source File | 1995-10-22 | 5.6 KB | 196 lines

{$A+,B-,D-,F-,G+,I+,K+,L-,N+,P+,Q-,R-,S+,T+,V-,W-,X+,Y-}
unit Unitperf;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls, FileCtrl, Outline, DirOutln, Gauges, Grids;

type
  TMainForm = class(TForm)
    DriveComboBox1: TDriveComboBox;
    DirectoryOutline1: TDirectoryOutline;
    FileListBox1: TFileListBox;
    Label1: TLabel;
    ExitButton: TButton;
    ViewButton: TButton;
    RenameButton: TButton;
    DeleteButton: TButton;
    CopyButton: TButton;
    Gauge1: TGauge;
    UUEncodeButton: TButton;
    UUDecodeButton: TButton;
    Button1: TButton;
    procedure DriveComboBox1Change(Sender: TObject);
    procedure DirectoryOutline1Change(Sender: TObject);
    procedure ExitButtonClick(Sender: TObject);
    procedure ViewButtonClick(Sender: TObject);
    procedure DeleteButtonClick(Sender: TObject);
    procedure RenameButtonClick(Sender: TObject);
    procedure UUEncodeButtonClick(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  MainForm: TMainForm;

implementation
Uses Unit2, Unit3, FileCopy, UUCode;

{$R *.DFM}

procedure TMainForm.DriveComboBox1Change(Sender: TObject);
begin
  DirectoryOutLine1.Drive := DriveComboBox1.Drive
end;

procedure TMainForm.DirectoryOutline1Change(Sender: TObject);
begin
  FileListBox1.Directory := DirectoryOutline1.Directory
end;

procedure TMainForm.ExitButtonClick(Sender: TObject);
begin
  Close
end;

procedure TMainForm.ViewButtonClick(Sender: TObject);
begin
  try
    ViewerForm.Memo1.Lines.LoadFromFile(FileListBox1.FileName);
    ViewerForm.Show
  except
    on E: Exception do
      MessageDlg(E.Message, mtError, [mbOk], 0)
  end
end;

procedure TMainForm.DeleteButtonClick(Sender: TObject);
var f: File;
    Str: String;
begin
  if FileListBox1.FileName <> '' then
  begin
    FmtStr(Str,'Do you want to delete %s',[FileListBox1.FileName]);
    if MessageDlg(Str, mtConfirmation, [mbYes,mbNo], 0) = mrYes then
    try
      try
        System.Assign(f,FileListBox1.FileName);
        Erase(f)
      except
        on E: Exception do
          MessageDlg(E.Message, mtError, [mbOk], 0)
      end;
    finally
      FileListBox1.Directory := '.';
      FileListBox1.Directory := DirectoryOutLine1.Directory { rescan }
    end
    else
      MessageDlg('No file deleted', mtInformation, [mbOk], 0)
  end
  else
    MessageDlg('No file selected', mtError, [mbOk], 0)
end;

  procedure CallBack(Position, Size: LongInt); export;
  var Progress: LongInt;
  begin
    Progress := (Position * MainForm.Gauge1.MaxValue) div Size;
    if MainForm.Gauge1.Progress <> Progress then { no unnecessary updates! }
      MainForm.Gauge1.Progress := Progress
  end {CallBack};

procedure TMainForm.RenameButtonClick(Sender: TObject);
var CallBackProc: TCallBack;
var f: File;
    FileName: String;
    Len: Byte absolute FileName;
begin
  if FileListBox1.FileName <> '' then
  begin
    FileNameDialog.OldFileName.Text := FileListBox1.FileName;
    FileNameDialog.NewFileName.Text := FileListBox1.FileName;
    if FileNameDialog.ShowModal <> idCancel then
    begin
      FileName := FileNameDialog.NewFileName.Text;
      try
        try
          if Sender = RenameButton then
          begin
            System.Assign(f,FileListBox1.FileName);
            System.Rename(f,FileName)
          end
          else { Sender = CopyButton }
          begin
            Gauge1.Progress := 0;
            CallBackProc := CallBack;
            FastFileCopy(FileListBox1.FileName,FileNameDialog.NewFileName.Text,
                         CallBackProc)
          end
        except
          on E: Exception do
            MessageDlg(E.Message, mtError, [mbOk], 0)
        end;
      finally
        FileListBox1.Directory := '.';
        FileListBox1.Directory := DirectoryOutLine1.Directory; { rescan }
        { TFileListBox chokes if the filename ends on a '.' }
        if FileName[len] = '.' then Dec(len);
        FileListBox1.FileName := FileName
      end
    end
  end
  else
    MessageDlg('No file selected', mtError, [mbOk], 0)
end;

procedure TMainForm.UUEncodeButtonClick(Sender: TObject);
var CallBackProc: TCallBack;
    FileName: String;
    Len: Byte absolute FileName;
    OutFileName: String[13];
    OutLen: Byte absolute OutFileName;
begin
  if FileListBox1.FileName <> '' then
  begin
    OutFileName := ChangeFileExt(ExtractFileName(FileListBox1.FileName),'.UUE') + #0;
    FileName := FileListBox1.FileName + #0;
    try
      try
        Gauge1.Progress := 0;
        CallBackProc := CallBack;
        if Sender = UUEncodeButton then
          UUEncoder(@FileName[1],@OutFileName[1],644,False,CallBackProc)
        else { Sender = UUDecodeButton }
          UUDecoder(@FileName[1],CallBackProc)
      except
        on E: Exception do
          MessageDlg(E.Message, mtError, [mbOk], 0)
      end;
    finally
      FileListBox1.Directory := '.';
      FileListBox1.Directory := DirectoryOutLine1.Directory; { rescan }
      Dec(OutLen);
      FileListBox1.FileName := OutFileName
    end
  end
  else
    MessageDlg('No file selected', mtError, [mbOk], 0)
end;

procedure TMainForm.Button1Click(Sender: TObject);
begin
  MessageDlg('Read the accompanying article in The Delphi Magazines'#13#10+
             'issues #4/#5 and #6 for more in-depth information about'#13#10+
             '16- and 32-bit Delphi Efficiency.',
              mtInformation,[mbOK],0)
end;

end.